home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / poker.src < prev    next >
Text File  |  1992-08-18  |  7KB  |  85 lines
  1. %%HP: T(1)A(D)F(.);
  2. @ POKER by Mauro Sgarban
  3. ½
  4. IFERR    DEPTH DROPN -40 FS?C 0 RìB DUP 2 ìLIST PVIEW
  5.  WHILE    1 
  6.  REPEAT   ERASE "ó0ó x0x ;0;  0  ó0 0ó   "
  7.           1 24 START DUP NUM 32 - RìB SWAP 2 24 SUB NEXT DROP 
  8.           1 6 START 2 ìLIST ROT ROT 2 ìLIST TLINE NEXT
  9.           PICT #93d 4 RìB 2 ìLIST "10$  " 3 ìGROB REPL  TIME RDZ 10
  10.   0 9 FOR n   MEM DROP
  11.        GROB 26 33 00000000000000000000000000000000000000000FFFF1000EF0E7000CF0CF000CF0CF000CF0CF000CF0CF00F30F30300CF0CF000CF0CF000CF0CF000CF0CF000CF0E7000CFFF1000CF000000CF000000CF000000CF000000CF00000F30FFF300CF000000CF000000CF000000EF100000FF3000000000000000000000000000000000000 GROB 26 33 000000000000000000000000000000000000000008FFF1000CF0F3000C70E3000E70E7000E70E7000E70E700F18F18300E70E7000E70E7000E70E7000E70E7000E70E7000E70E7000E70E7000E70E7000E70E7000E70E7000E70E700F18F18300E70E7000E70E7000C70E3000CF0F30008FFF10000000000000000000000000000000000 GROB 26 33 00000000000000000000000000000000000000008FF0CF100F7007000E7003000E7081000E70C0000E706000F18FCF300E7810000E7C00000E7600000E7F00000EFF00000EFF10000E7F30000E7F30000E7E70000E7CF0000E7CF000F1870E300E70F3000E70F3000E70E7000FF0CF008FF1EF1000000000000000000000000000000000 GROB 26 33 00000000000000000000000000000000000000000FFFF7000EF087000CF007000CF006000CF004000CF00000F30FFF300CF000000CF000000CF040000CF060000CF070000CFF70000CF070000CF060000CF040000CF000000CF00000F30FFF300CF004000CF006000CF007000EF087000FFFF70000000000000000000000000000000000 GROB 27 33 0000000000000000000000000000000000000000CFFF70008F38F1000F30F3000F30F3000F30F3000F30F300F0CF0C700F30F3000F30F3000F30F3000F30F3000F38F1000FFF70000F38F1000F30F3000F30F3000F30F3000F30F300F0CF0C700F30F3000F30E3000F30E3008F70C700CFF08F0000000000000000000000000000000000
  12.        0 4 FOR k   PICT n {4 INV WAIT #104d k 26* - #30d 2 ìLIST ROT }{ k 26 * RìB #30d 2 ìLIST 7 k - ROLL} IFTE REPL NEXT 
  13.        PICT 3 RìB 4 RìB 2 ìLIST  " I   II III  IV  V   VI VII VIII IX  X  " n 4 * 1 + DUP 3 + SUB 3 ìGROB REPL
  14.        PICT 9 RìB #21d 2 ìLIST  "  FAI LA PUNTATA  " 2 ìGROB REPL ""
  15.    DO    PICT #30d 5 RìB 2 ìLIST "    *    " 2 ìGROB REPL DROP "" 
  16.     WHILE   "\RSTHIJ>?@3" 0 WAIT CHR POS DUP 11 ï 3 PICK "" SAME OR
  17.     REPEAT  1 - DUP -1 SAME OVER 10 SAME OR { DROP "" } IFT + DUP 0 ìSTR SAME { DROP "" } IFT
  18.             PICT #30 5 RìB 2 ìLIST 3 PICK "$    " + 1 4 SUB 2 ìGROB REPL
  19.     END     DROP
  20.    UNTIL DUP2 OBJì  è
  21.    END
  22.   SWAP OVER OBJì - SWAP PICT #93d 4 RìB 2 ìLIST 4 PICK "$    " + 1 6 SUB 3 ìGROB REPL 
  23.                         PICT 1 RìB #21d 2 ìLIST  #131d 9 RìB BLANK REPL 
  24.   { 5 } 0 CON { 0 } 
  25.    1 5 FOR j
  26.      3 j SAME
  27.      { SWAP
  28.         WHILE "01234X" 0 WAIT 37 + CHR POS DUP 6 ï
  29.         REPEAT  DUP { PICT OVER 26* 16 - RìB #25d 2 ìLIST GROB 7 4 F7E3C180 GXOR { 5 } 0 CON SWAP 1 PUT +} { DROP } IFTE
  30.         END
  31.        DROP SWAP PICT 1 RìB #25d 2 ìLIST # 83h  4 RìB BLANK REPL }
  32.      { MEM DROP
  33.        1 5 FOR i
  34.          OVER i GET 2 MOD 0 SAME
  35.          { PICT i 26 * 25 - RìB #30d 2 ìLIST j 3 MOD 1 SAME 
  36.            { GROB 25 33 CFFFF70020000800100000101401401012802010114010109028021010140110180280101401401012802010114010109028021010140110180280101401401012802010114010109028021010140110180280101401401012802010114010109028021010140110180280101401401012802010104010101000001020000800CFFFF700 REPL
  37.              DO RAND 52 * CEIL DUP2 POS
  38.              UNTIL 0 ï { DROP 0 } 1 IFTE
  39.              END
  40.              OVER i GET 3 ROLLD 1 ìLIST i SWAP REPL SWAP 1 ìLIST +}
  41.            { {GROB 25 33 CFFFF70020000800100000101F8700109FDF0010D9FC1010D0781010D0281010D0081010D10C1010910C0010930E0010170700101E8300101CD1001018F0001010700010102000101000001010000010100000101000001010000010100000101000001010000010100000101000001010000010100000101000001020000800CFFFF700 GROB 25 33 CFFFF7002000080010000010102000101070001018F000101CD100101E83001017070010930E0010D10C1010930E0010170700101E8300101CD1001018F0001010700010102000101000001010000010100000101000001010000010100000101000001010000010100000101000001010000010100000101000001020000800CFFFF700 GROB 25 33 CFFFF7002000080010000010107000101CF100101CF100101CF100101CF100109BFE00109FFF0010DFFF1010DFFF1010DFFF1010DFFF1010977F001018F000101CF100101EF300101000001010000010100000101000001010000010100000101000001010000010100000101000001010000010100000101000001020000800CFFFF700 GROB 25 33 CFFFF70020000800100000101070001018F000101CF100101EF300101FF700109FFF00109FFF0010DFFF1010DFFF1010DFFF1010DFFF1010977F001018F000101CF100101EF300101000001010000010100000101000001010000010100000101000001010000010100000101000001010000010100000101000001020000800CFFFF700 }
  42.              4 PICK i GET 12 + 13/ IP GET { #10d  #21d } 5 PICK i GET 13 MOD 1 + " K A 2 3 4 5 6 7 8 910 J Q" SWAP 2 * DUP 1 - SWAP SUB 3 ìGROB GOR REPL}
  43.            IFTE
  44.          } IFT
  45.        NEXT }
  46.      IFTE
  47.    NEXT 
  48.    { 4 13 } 0 CON 
  49.    1 5 FOR i OVER i GET 1 PUT NEXT
  50.    DUP TRN { 4 } 1 CON * 
  51.   DUP RNRM 1 ï
  52.   { {"COPPIA  1" "DOPPIA COPPIA  2" "TRIS  3" "FULL 12" "NIENTE  0" "POKER 25" } OVER ABS SQ 2 / IP 2 -  
  53. DUP 1 SAME 
  54. { DROP OVER 2 1 9 START 0 PUTI NEXT DROP RNRM 2 SAME 1 5 IFTE } 
  55. IFT 
  56.   GET 5 ROLLD 4 DROPN }
  57.   { SWAP RNRM 5 SAME 4 1 IFTE OVER ìSTR "1 1 1 1 1" POS 0 SAME 0 1 IFTE + SWAP ìSTR "1 0 0 0 0 0 0 0 0 1 1 1 1" POS 0 SAME 0 2 IFTE + { "NIENTE  0" "SCALA  6" "SCALA ALL'ASSO  8" "COLORE 10" "SCALA REALE100" "SCALA REALE ALL'ASSO200"} SWAP GET 3 ROLLD DROP2 }
  58.   IFTE 
  59.    DUP DUP SIZE DUP 2 - SWAP SUB PICT #60d 5 RìB 2 ìLIST 3 PICK "   " + 1 4 SUB 2 ìGROB REPL OBJì ROT OBJì * ROT + DUP 99999 > { DROP 99999 } IFT DUP 0 SAME ½ 9 'n' STO ╗ IFT SWAP PICT 9 RìB  #21d 2 ìLIST ROT 1 OVER SIZE 3 - SUB "                    " +  2 ìGROB REPL PICT #93d 4 RìB 2 ìLIST 3 PICK "$    " + 1 6 SUB 3 ìGROB REPL
  60.  NEXT
  61. IF 'RECORD' VTYPE -1 SAME THEN "MAURO" 1 DUP2 4 DUPN 6 DUPN 0 CHR 15 ìLIST 'RECORD' STO END
  62. IF RECORD DUP2 2 GET è
  63. THEN PICT 9 RìB  #21d 2 ìLIST "SCRIVI IL TUO NOME" 2 ìGROB REPL "" 
  64.  WHILE "012345:;<=>?DEFGHINOPQRSYZX" 0 WAIT 37 + CHR POS DUP DUP 27 ï 4 PICK SIZE 8 ï AND
  65.  REPEAT 
  66.   { 96 + CHR + PICT #30d 5 RìB 2 ìLIST 3 PICK "........" + 1 8 SUB "#" + 2 ìGROB REPL } 
  67.   { DROP } 
  68.   IFTE
  69.  END DROP2
  70.   0 4 ROLLD 4 ROLLD
  71.   1 7 FOR h DUP2 h 2 * GET è 4 ROLL + 3 ROLLD NEXT 
  72.   ROT 2 * DUP2 3 SWAP SUB ROT SWAP 1 SWAP REPL SWAP 1 - 4 ROLLD 4 ROLLD 2
  73.   ìLIST REPL 'RECORD' STO 
  74. ELSE DROP2
  75. END
  76.   PICT 0 RìB DUP 2 ìLIST
  77.   #131d #64d BLANK #44d 0 RìB 2 ìLIST "RECORD" 3 ìGROB GOR
  78.   0 RìB 9 RìB 2 ìLIST RECORD OBJì DROP2 
  79.   1 7 FOR l "    " + 1 5 SUB "................." SWAP + 1 ROT REPL l DISP NEXT 
  80.   LCDì REPL REPL 0 WAIT DROP
  81.  END 
  82. THEN DEPTH 1 - DROPN { -40 SF } IFT 'PPAR' PURGE ERASE
  83. END 
  84. ╗
  85.